Computer Shopper 233/Computer Shopper 233/ComputerShopperDVD233.iso/mpf/eng/shared/agentdui.cab/scui.dll/HTML/COMMON.VBS

Text File | 2005-07-27 | 9.6 KB | 416 lines

Function window_onerror( sMsg, sUrl, nLine )
'{
    MsgBox DB_FATAL_ERROR & vbCrLf & vbCrLf & "Msg: " & sMsg & vbCrLf & "Url:" & sUrl & vbCrLf & "Line No:" & CStr(nLine)
    'window.external.close
    window.event.returnValue = TRUE '// Dont display IE message.
'}
End Function

Function GetInternetConnectedState()
'{
    If top.gObjDashboard is nothing Or not IsObject( top.gObjDashboard ) Then
        Exit Function
    End If

    Dim bINetConnected
    Dim bInetState

    bINetConnected = top.gObjDashboard.GetInternetConnectedState( bInetState )

    GetInternetConnectedState = bINetConnected
'}
End Function

Function LaunchURL( szUrlToLaunch )
'{
    If top.gObjDashboard is nothing Or not IsObject( top.gObjDashboard ) Then
        Exit Function
    End If

    Dim bINetConnected
    Dim bInetState

    bINetConnected = top.gObjDashboard.GetInternetConnectedState( bInetState )
    If bINetConnected Then
        If "" <> szUrlToLaunch Then
            window.open szUrlToLaunch, "McDash"
        End If
    Else
        MsgBox DB_INET_NOT_CONNECTED_ERROR
    End If

    LaunchURL = TRUE
'}
End Function

Function LaunchURLInWindow( szUrl, szTarget, szWindowParams )
'{
    If top.gObjDashboard is nothing Or not IsObject( top.gObjDashboard ) Then
        Exit Function
    End If

    Dim bINetConnected
    Dim bInetState

    bINetConnected = top.gObjDashboard.GetInternetConnectedState( bInetState )

    If bINetConnected Then
        If "" <> szUrl Then
            window.open szUrl, szTarget, szWindowParams
        End If
    Else
        MsgBox DB_INET_NOT_CONNECTED_ERROR
    End If

    LaunchURLInWindow = TRUE
'}
End Function

Function LaunchURLOrExe( szURL )
'{
    Dim bInetState, szFile
    'On Error Resume Next
    If g_localObjOS Is Nothing Or Not IsObject( g_localObjOS ) Then
        Exit Function
    End If
    If g_localObjFS Is Nothing Or Not IsObject( g_localObjFS ) Then
        Exit Function
    End If

    If (IsProgram(szURL)) Then
        szFile = Mid(szURL, 8)
        If (":\" <> Mid(szFile, 2, 2)) Then
            szFile = GetObjectPath( CLSID_MCAgent, g_localObjOS, g_localObjFS ) & "\" & szFile
        End If
        If 0 <> g_localObjOS.RunProgram(szFile, "") Then
            MsgBox DB_PROGRAM_LAUNCH_ERROR
        End If
    Else
        LaunchURL(szUrl)
    End If
    window.event.returnValue = FALSE
    'On Error Goto 0
'}
End Function


Function ShellExecuteURL( szURL, ByRef g_localObjOS, ByRef g_localObjFS, ByRef g_localObjShell )
'{

    Dim bInetState
    'On Error Resume Next

    If g_localObjOS Is Nothing Or Not IsObject( g_localObjOS ) Then
        Exit Function
    End If

    If g_localObjFS Is Nothing Or Not IsObject( g_localObjFS ) Then
        Exit Function
    End If

    If g_localObjShell Is Nothing Or Not IsObject( g_localObjShell ) Then
        Exit Function
    End If

    If ( Not IsHttp(szURL) ) Then
        If 0 <> g_localObjShell.ShellExecute(szURL) Then
            MsgBox DB_PROGRAM_LAUNCH_ERROR
        End If
    Else
        Call LaunchURL(szUrl)
    End If

    window.event.returnValue = FALSE
    'On Error Goto 0
'}
End Function


Function IsProgram(szURL)
'{
    IsProgram = FALSE
    '// file://a.exe
    If (11 < Len(szURL)) Then
        If ( (0 =  StrComp("file://", Left(szURL, 7), 1)) And _
             (0 <> StrComp(".htm",  Right(szURL, 4), 1))  And _
             (0 <> StrComp(".html", Right(szURL, 5), 1)) ) Then
            IsProgram = TRUE

        End If

    End If
'}
End Function


Function IsHttp(szUrl)
'{

    If (0 =  StrComp("http://", Left(szUrl, 7), 1) ) Then
        IsHttp = True
    Else
        IsHttp = False
    End If

'}
End Function

Function GetObjectPath( sCLSID, objOS, objFS )
'{
    Dim   sPath

    GetObjectPath = ""
    sPath = objOS.GetObjectModuleDir( sCLSID )
    If "" = sPath Then
    '{
        Exit Function
    '}
    End If

    GetObjectPath = objFS.GetShortPathName( sPath )
'}
End Function

Function LaunchHelp( sUrl, objOS )
'{
  Dim sHHPath, sHelpUrl

  window.event.cancelBubble = True

  '// Check if required objects are present...
  If False = IsObject( objOS ) Then
    Exit Function
  End If

  If objOS is nothing Then
    Exit Function
  End If

  '// Get HH.EXE path...
  sHHPath = objOS.WindowsDirectory
  If "\" <> Right( sHHPath, 1 ) Then
    sHHPath = sHHPath & "\"
  End If
  sHHPath = sHHPath & "hh.exe"

  If "" <> sUrl Then
      '// Start the Help
      call objOS.RunProgram( sHHPath, sUrl )
  End If

'}
End Function


Function GetAppSecurityIndex( szAppId )
'{
    GetAppSecurityIndex = 0

    Dim localObjMcScIndx
    Const SECIDX_SUCCESS = 0

    Dim nSecIdx
    nSecIdx = 0

    Set localObjMcScIndx = Nothing

    If IsEmpty (top.gobjExternal.GetParam("MYS_SEC_IDX")) Then
        Set localObjMcScIndx = top.gobjExternal.CreateObject( CLSID_CoMCSecurityIndex, CLSID_LIC, true )
        'Call top.gobjExternal.SetParam("MYS_SEC_IDX", localObjMcScIndx)
    Else
        Set localObjMcScIndx = top.gobjExternal.GetParam("MYS_SEC_IDX")
    End If

    If Not localObjMcScIndx is Nothing And IsObject( localObjMcScIndx ) Then
        If ( SECIDX_SUCCESS <> localObjMcScIndx.GetAppSecurityIndex(szAppId, nSecIdx) ) Then
            nSecIdx = -1
        End If
    End If

    Set localObjMcScIndx = Nothing

    GetAppSecurityIndex = nSecIdx
'}
End Function

Function GetTitleStateSpecs( state, ByRef backgroundColor, ByRef borderColor, ByRef ltCornerImg, ByRef lbCornerImg, ByRef rtCornerImg, ByRef rbCornerImg, ByRef streetLight )
'{
    Select Case state
    '{
        case DB_NO_PROD_INSTALLED
            backgroundColor = DB_NOTINSTALLED_BGCLR_STR
            borderColor = DB_NOTINSTALLED_BORDERCLR_STR
            ltCornerImg = DB_NOTINSTALLED_LTIMG_STR
            lbCornerImg = DB_NOTINSTALLED_LBIMG_STR
            rtCornerImg = DB_NOTINSTALLED_RTIMG_STR
            rbCornerImg = DB_NOTINSTALLED_RBIMG_STR
            streetLight = DB_NOT_INSTALLED_STRTLT_STR
        case DB_PROD_ENABLED
            backgroundColor = DB_ENABLED_BGCLR_STR
            borderColor = DB_ENABLED_BORDERCLR_STR
            ltCornerImg = DB_ENABLED_LTIMG_STR
            lbCornerImg = DB_ENABLED_LBIMG_STR
            rtCornerImg = DB_ENABLED_RTIMG_STR
            rbCornerImg = DB_ENABLED_RBIMG_STR
            streetLight = DB_ENABLED_STRTLT_STR
        case DB_PROD_DISABLED
            backgroundColor = DB_DISABLED_BGCLR_STR
            borderColor = DB_DISABLED_BORDERCLR_STR
            ltCornerImg = DB_DISABLED_LTIMG_STR
            lbCornerImg = DB_DISABLED_LBIMG_STR
            rtCornerImg = DB_DISABLED_RTIMG_STR
            rbCornerImg = DB_DISABLED_RBIMG_STR
            streetLight = DB_DISABLED_STRTLT_STR
    '}
    End Select
'}
End Function

' NOTE: Caller should only add one to return value for MPF3.0
' Returns # days remaining until service expires.
' -2 = Doesn't expire or error (no expiry entry found)
' -1 = Expired sometime in past
' 1+ = Days remaining until trial service expires.
Function GetExpiryDays(objLegacySubMgr, szAppId)
'{
    Dim lRetVal

    If objLegacySubMgr is nothing Or Not IsObject( objLegacySubMgr ) Then
        GetExpiryDays = dwDays
        Exit Function
    End If

    GetExpiryDays = objLegacySubMgr.GetExpiryDays(szAppId, lRetVal)
'}
End Function


' Follows this algorithm...
' 1. If No Die is set then returns 0
' 2. Calls IsAppExpired... If it returns -1 (unknwown expiry) or Result <> 7000 (SUCCESS)
'    then checks if bPerpetual = True. Returns 2 (PERPETUAL & EXPIRED) if Perpetual otherwise returns 1
'    which means SUBSCRIPTION & EXPIRED.

' IsAppExpired returns the following values...
' 0 = NOT_EXPIRED
' 1 = SUBSCRIPTION_EXPIRED
' 2 = PERPETUAL_EXPIRED
' 4 = TRIAL_EXPIRED
' 8 = NO_DIE_EXPIRED
' -1 = EXPIRY_UNKNWON (because of some error...)

Function IsAppExpired(ByVal szAppId, ByRef objLegacySubMgr)
'{

    Dim lRetVal
    Dim bNoDie, bPerpetual, bTrial

    bNoDie      = False
    bPerpetual  = False
    bTrial      = False

    ' 7000 = SUCCESS as defined MCSUBDEF.H
    ' 7020 = MCSUBOBJRET_INVALID_APPSUBINFO. We will get this if Settings is not found in registry or
    ' in the case of sub aware apps we dont find it in the database.

    lRetVal = 7000

    If ( Len(szAppId) = 0 ) Or ( Not IsObject(objLegacySubMgr) ) Then
    '{
        IsAppExpired = 0
        Exit Function
    '}
    End If

    ' first check if this is NO_DIE
    bNoDie = objLegacySubMgr.IsNoDie(szAppId, lRetVal)
    If 7000 <> lRetVal Then
        bNoDie = False
    End If

    If bNoDie Then
    '{
        IsAppExpired = 0
        Exit Function
    '}
    End If

    lRetVal = 7000

    bTrial = objLegacySubMgr.IsTrial(szAppId, lRetVal)
    If 7000 <> lRetVal Then
        bTrial = False
    End If

    lRetVal = 7000

    If Not bTrial Then
    '{

        bPerpetual = objLegacySubMgr.IsPerpetual(szAppId, lRetVal)
        If 7000 <> lRetVal Then
            bPerpetual = False
        End If

    '}
    End If

    lRetVal = 7000

    IsAppExpired = objLegacySubMgr.IsAppExpired(szAppId, lRetVal)

    If (7000 <> lRetVal) Or (-1 = IsAppExpired) Then
    '{
        If bPerpetual Then
            IsAppExpired = 2
        Else
            IsAppExpired = 1
        End If
    '}
    Else
    '{
        ' 4 = Trial Expired... Treat it the same way as a normal subscription has expired...

        If 4 = IsAppExpired Then
            IsAppExpired = 1
        End If
    '}
    End If

'}
End Function

Function GetRunningFlag(ByVal nExpiry)
'{

    Dim isRunningFlag

    ' default is protecting...
    ' This function will be called ONLY when nExpiry > 0
    isRunningFlag = 1

    If (nExpiry > 0) Then
    '{

        ' Trial expired or paid subscription expired...

        If (1 = nExpiry) Or (4 = nExpiry) Then
        '{
            ' Subscription is expired...
            isRunningFlag = 100
        '}
        Else
        '{
            ' Perpetual is true and perpetual subscription expired... Or
            isRunningFlag = 101
        '}
        End If

    '}
    End If

    GetRunningFlag = isRunningFlag

'}
End Function